perm filename DPYARC.SAI[1,BGB] blob sn#001236 filedate 1972-10-22 generic text, type T, neo UTF8
00100	ENTRY FLYCAM;
00200	BEGIN "DPYARC"
00300		DEFINE α="COMMENT", π="3.1415927";
00400	α DISPLAY FUNCTIONS, BUFFER & DPY TEMPORARIES;
00500		REQUIRE "DISPLY[SYS,BGB]" LOAD_MODULE;
00600		EXTERNAL PROCEDURE DPYSET(INTEGER ARRAY DPYBUF);
00700		EXTERNAL PROCEDURE DPYOUT(INTEGER GLASS);
00800		EXTERNAL PROCEDURE HYDPOG(INTEGER GLASS);
00900		EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
01000		EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
01100		EXTERNAL PROCEDURE RVECT(INTEGER X,Y);
01200		EXTERNAL PROCEDURE DPYSST(STRING S);
01300		EXTERNAL PROCEDURE DPYBIG(INTEGER SIZE);
01400		SAFE INTEGER ARRAY DPYBUF[0:2000];
01500		INTEGER DPYMODE,AERIALMODE,CAMERAMODE,FACTOR,OLDX,OLDY;
01600	α ARC ENDPOINTS A & B ARE RELATIVE TO ARC CENTER AT C,
01700	  ARC GOES β DEGREES FROM POINT A COUNTER CLOCKWISE TO B;
01800		SAFE INTEGER ARRAY ARCPDL[1:10,1:7];	α AX,AY,BX,BY,β,AZ,BZ;
01900	α ARC TEMPORARIES, MIDPOINT & MIDARC;
02000		REAL AX,AY,AZ,BX,BY,BZ,CX,CY,CZ,R,RR,β; INTEGER MZ,NZ,MX,MY,NX,NY;
02100	α WORLD MODEL DATA;
02200		EXTERNAL REAL   ARRAY LOCII[0:400,1:3];
02300		EXTERNAL INTEGER ARRAY ARCS[1:300,1:3];
02400		EXTERNAL INTEGER ARRAY SEGS[1:300,1:2];
02500	α TIMING RECORD;
02600		INTEGER TIM,INITIM,OLDTIM,DIFTIM,AVG,MAX,MIN,T;
02700	α TRIG FUNCTIONS & TABLES;
02800		REQUIRE "SAITRG[SYS,BGB]" LOAD_MODULE;
02900		EXTERNAL REAL PROCEDURE COS(REAL X);
03000		EXTERNAL REAL PROCEDURE SIN(REAL X);
03100		EXTERNAL REAL PROCEDURE ACOS(REAL X);
03200		EXTERNAL REAL PROCEDURE ATAN2(REAL Y,X);
03300		SAFE REAL ARRAY	SINE,COSINE[0:180];
03400		EXTERNAL REAL PROCEDURE SQRT(REAL X);
03500	α CLIPPER SUBROUTINE, ARGS & VALS;
03600		EXTERNAL PROCEDURE CLIP2D;
03700		EXTERNAL INTEGER X1,Y1,X2,Y2,XL,XH,YL,YH,FLAG;
03800	α DRIVER SUBROUTINE & PARAMETERS;
03900		EXTERNAL PROCEDURE COURSE;
04000		EXTERNAL BOOLEAN PROCEDURE DRIVE;
04100		EXTERNAL PROCEDURE INITIAL;
04200		EXTERNAL REAL ARRAY MCL,MVL,EVL,ECL[1:4,1:3];
04300		EXTERNAL REAL PAN,TILT,WHEELS,
04400			AARCX,	AARCY,	AARCZ,
04500			BARCX,	BARCY,	BARCZ,
04600			COTX,	COTY,	COTZ;
04700	α CAMERA FLYER STRENGTHS;
04800		REAL ROTDEL,TRNDEL;
     

00100	PROCEDURE GETARC (INTEGER I);
00200	BEGIN
00300		INTEGER PTR;
00400		REAL COSINE;
00500		PTR	←	ARCS[I,1];
00600		AX	←	LOCII[PTR,1];
00700		AY	←	LOCII[PTR,2];
00800		AZ	←	LOCII[PTR,3];
00900		PTR	←	ARCS[I,2];
01000		BX	←	LOCII[PTR,1];
01100		BY	←	LOCII[PTR,2];
01200		BZ	←	LOCII[PTR,3];
01300		PTR	←	ARCS[I,3];
01400		CX	←	LOCII[PTR,1];
01500		CY	←	LOCII[PTR,2];
01600		CZ	←	LOCII[PTR,3];
01700		AX	←	AX - CX;
01800		AY	←	AY - CY;
01900		BX	←	BX - CX;
02000		BY	←	BY - CY;
02100		RR	←	(AX↑2 + AY↑2 + BX↑2 + BY↑2)/2;
02200		R	←	SQRT(RR);
02300		COSINE	←	(AX*BX + AY*BY) /(SQRT(AX↑2 + AY↑2)*SQRT(BX↑2 + BY↑2));
02400		β	←	180*ACOS(COSINE)/π;
02500		IF AX*BY < BX*AY THEN
02600	BEGIN
02700		AX	↔	BX;
02800		AY	↔	BY;
02900		AZ	↔	BZ;
03000	END;
03100	END;
     

00100	PROCEDURE DPYLAB (REAL X,Y,Z; STRING S);
00200	BEGIN
00300		REAL XX,YY,ZZ;
00400		X	←	X - ECL[4,1];
00500		Y	←	Y - ECL[4,2];
00600		Z	←	Z - ECL[4,3];
00700		XX	←	X*ECL[1,1] + Y*ECL[1,2] + Z*ECL[1,3];
00800		YY	←	X*ECL[2,1] + Y*ECL[2,2] + Z*ECL[2,3];
00900		ZZ	←	X*ECL[3,1] + Y*ECL[3,2] + Z*ECL[3,3];
01000		IF ZZ>-(0.25/12) THEN RETURN;
01100		XX	←	-(XX/ZZ)*2↑10  -  14;
01200		YY	←	-(YY/ZZ)*2↑10  -  6;
01300		IF YY<YL ∨ YY>YH ∨ XX<XL ∨ XX>XH THEN RETURN;
01400		AIVECT(XX,YY);
01500		DPYSST(S);
01600	END;
01700	
01800	INTERNAL PROCEDURE DPYV;
01900	BEGIN
02000		INTEGER I;
02100		DPYSET(DPYBUF);
02200		DPYBIG(1);
02300		FOR I←0 STEP 1 UNTIL 195 DO
02400		DPYLAB(LOCII[I,1],LOCII[I,2],LOCII[I,3],"* V"&CVS(I));
02500		DPYBIG(2);
02600		DPYOUT(5);
02700	END;
     

00100	PROCEDURE CAMERADPY; 
00200	BEGIN "CAMERA DPY"
00300		INTEGER I,J;
00400		REAL CIX,CIY,CIZ,	TX1,TY1,TZ1,TX2,TY2,TZ2,
00500	             CJX,CJY,CJZ,	RX1,RY1,RZ1,RX2,RY2,RZ2,
00600	             CKX,CKY,CKZ,	DELNEW,DELTAZ,
00700	             CCX,CCY,CCZ,	MX,MY,MZ,F,Q1,Q2,		NX,NY,NZ,
00800		     DXM,DYM,DZM,       DXN,DYN,DZN,			RESOLVE,
00900		     RRM,RRN,PHI;
01000		SAFE REAL ARRAY ARCPDL[1:10,1:7];
01100	
     

00100	α 3D -  LINE SEGMENT DISPLAY SUBROUTINE;
00200	
00300	PROCEDURE LSD3D (REAL XX1,YY1,ZZ1,XX2,YY2,ZZ2);
00400	BEGIN	"LSD-3D"
00500		TX1	←	XX1 - CCX;			α TRANSLATION;
00600		TY1	←	YY1 - CCY;
00700		TZ1	←	ZZ1 - CCZ;
00800		TX2	←	XX2 - CCX;
00900		TY2	←	YY2 - CCY;
01000		TZ2	←	ZZ2 - CCZ;
01100		RX1	←	TX1*CIX + TY1*CIY + TZ1*CIZ;	α ROTATION;
01200		RY1	←	TX1*CJX + TY1*CJY + TZ1*CJZ;
01300		RZ1	←	TX1*CKX + TY1*CKY + TZ1*CKZ;
01400		RX2	←	TX2*CIX + TY2*CIY + TZ2*CIZ;
01500		RY2	←	TX2*CJX + TY2*CJY + TZ2*CJZ;
01600		RZ2	←	TX2*CKX + TY2*CKY + TZ2*CKZ;
01700		IF 	RZ1 < -F   ∨   RZ2 < -F     THEN	α IN FRONT OF CAMERA PLANE TEST;
01800	BEGIN	"INVIEW"
01900		IF	RZ2 < -F	THEN			α FORCE POINT-1 INVIEW;
02000	BEGIN	"SWAP"
02100		RX1	↔	RX2;
02200		RY1	↔	RY2;
02300		RZ1	↔	RZ2;
02400	END	"SWAP";
02500		IF	RZ2 > -F    THEN			α 3D-CLIPPING;
02600	BEGIN	"3D-CLIP"
02700		DELTAZ	←	RZ2 - RZ1;
02800		RZ2	←	-F;
02900		DELNEW	←	RZ2 - RZ1;
03000		RX2	←	DELNEW * (RX2 - RX1) / DELTAZ  +  RX1;
03100		RY2	←	DELNEW * (RY2 - RY1) / DELTAZ  +  RY1;
03200	END	"3D-CLIP";
03300	
03400	α PERSPECTIVE PROJECTION  AND  SCALING PHYSICAL TO LOGICAL;
03500		X1	←	-(RX1/RZ1) * 2↑10;
03600		Y1	←	-(RY1/RZ1) * 2↑10;
03700		X2	←	-(RX2/RZ2) * 2↑10;
03800		Y2	←	-(RY2/RZ2) * 2↑10;
03900	α YE OLDE 2D-CLIPPER;
04000		CLIP2D;
04100		IF FLAG THEN 
04200	BEGIN 
04300		AIVECT(X1,Y1);
04400		AVECT(X2,Y2) ;
04500	END;
04600	END	"INVIEW";
04700	END	"LSD-3D";
     

00200	α CAMERA DPY CONTINUED - INITIALIZATION & SEGMENT DPY;
00300		DPYSET(DPYBUF);
00400		F	←	0.25/12;	α THE FOCAL LENGTH IN FEET;
00500		RESOLVE	←	COS(20/1000)↑2;	α DISPLAY RESOLUTION  - MAJOR QUANTUM PER CAMERA ANGLE;
00600		CIX←ECL[1,1];	CIY←ECL[1,2];	CIZ←ECL[1,3];
00700		CJX←ECL[2,1];	CJY←ECL[2,2];	CJZ←ECL[2,3];
00800		CKX←ECL[3,1];	CKY←ECL[3,2];	CKZ←ECL[3,3];
00900		CCX←ECL[4,1];	CCY←ECL[4,2];	CCZ←ECL[4,3];
01000	
01100		FOR I←1 STEP 1 UNTIL 82 DO 
01200	BEGIN
01300		INTEGER END1,END2;
01400		REAL X1,Y1,Z1,X2,Y2,Z2;
01500		END1	←	SEGS[I,1];
01600		END2	←	SEGS[I,2];
01700		X1	←	LOCII[END1,1];		X2	←	LOCII[END2,1];
01800		Y1	←	LOCII[END1,2];		Y2	←	LOCII[END2,2];
01900		Z1	←	LOCII[END1,3];		Z2	←	LOCII[END2,3];
02000		LSD3D(X1,Y1,Z1,X2,Y2,Z2);
02100	END;
     

00100	α CAMERA DPY CONTINUED  -  ARC DISPLAY;
00200		FOR I←1 STEP 1 UNTIL 98 DO
00300	BEGIN "ARC DPY"
00400		GETARC(I);
00500		TX1	←	CX  -  CCX;
00600		TY1	←	CY  -  CCY;
00700		TZ1	←	CZ -  CCZ;
00800		RZ1	←	TX1*CKX + TY1*CKY + TZ1*CKZ;
00900	α IS THE ARC'S CENTER WITHIN A RADIUS OF THE CAMERA'S BACKSIDE ?;
01000		IF 	RZ1  <  R - F    THEN
01100	BEGIN "ARC L-LOOP"
01200		LABEL L;
01300		β	←	β * 3.14/180;
01400	α MIDPOINT;
01500	L:	MX	←	(AX + BX)/2;
01600		MY	←	(AY + BY)/2;
01700		MZ	←	(AZ + BZ)/2;
01800	α MIDARC;
01900		β	←	β/2;
02000		NX	←	((AX+BX)*COS(β) - (AY-BY)*SIN(β))/2;
02100		NY	←	((AX-BX)*SIN(β) + (AY+BY)*COS(β))/2;
02200		NZ	←	MZ;
02300	α ARE WE DOWN TO THE RESOLUTION OF THE DISPLAY ?;
02400		DXM	←	(CX + MX - CCX);
02500		DYM	←	(CY + MY - CCY);
02600		DZM	←	      MZ - CCZ;
02700		RRM	←	SQRT( DXM↑2 + DYM↑2 + DZM↑2);
02800		DXN	←	(CX + NX - CCX);
02900		DYN	←	(CY + NY - CCY);
03000		DZN	←	      NZ - CCZ;
03100		RRN	←	SQRT( DXN↑2 + DYN↑2 + DZN↑2);
03200		Q1	←	DXM*DXN  +  DYM*DYN  +  DZM*DZN;
03300		PHI	←	ACOS( Q1/(RRM*RRN));
03400		IF 10>5000*PHI ∨ J=9 ∨ (β<0.02)   THEN
03500			LSD3D(CX + AX,CY + AY,AZ,CX + BX,CY + BY,BZ) ELSE
     

00100	α CAMERA DPY CONTINUED;
00200	BEGIN "ARC PUSHER"
00300		J 	←	J+1;		α PUSH 'EM DOWN;
00400		IF J=10 THEN OUTSTR("ARCPDL OVER J=10 !"&13&10);
00500			ARCPDL[J,3] ← BX;
00600			ARCPDL[J,4] ← BY;
00700			ARCPDL[J,7] ← BZ;
00800		BX ← 	ARCPDL[J,1] ← NX;
00900		BY ← 	ARCPDL[J,2] ← NY;
01000		BZ ←	ARCPDL[J,6] ← NZ;
01100			ARCPDL[J,5] ← β;
01200		GO L;
01300	END   "ARC PUSHER";
01400		IF J≠0 THEN
01500	BEGIN "POPPER"
01600		AX	←	ARCPDL[J,1];
01700		AY	←	ARCPDL[J,2];
01800		AZ	←	ARCPDL[J,6];
01900		BX	←	ARCPDL[J,3];
02000		BY	←	ARCPDL[J,4];
02100		BZ	←	ARCPDL[J,7];
02200		β	←	ARCPDL[J,5];
02300		J	←	J-1;
02400		GO L;
02500	END   "POPPER";
02600	END   "ARC L-LOOP";
02700	END   "ARC DPY";
     

00100	α TIMING AND DISPLAY;
00200		OLDTIM←TIM;
00300		TIM ← CALL(0,"RUNTIM");
00400		T←T+1;
00500		AVG ← (TIM-INITIM)/T;
00600		DIFTIM←TIM-OLDTIM;
00700		IF DIFTIM>MAX THEN MAX←DIFTIM;
00800		IF DIFTIM<MIN THEN MIN←DIFTIM;
00900		AIVECT(-480,-465);
01000		DPYSST("MAX = "&CVS(MAX));
01100		DPYSST("   MIN = "&CVS(MIN));
01200		DPYSST("   AVG = "&CVS(AVG));
01300		DPYSST("   NOW = "&CVS(DIFTIM));
01400		DPYOUT(1);
01500	END "CAMERA DPY";
01600	
     

00100	α ECL & ROT/DEL PARAMETERS DISPLAYED IN UPPER LEFT HAND CORNER;
00200	PROCEDURE ECLDPY;
00300	BEGIN
00400		REAL PAN,TILT,SWING;
00500		INTEGER ARRAY DPYBUF[1:100];
00600		DPYSET(DPYBUF);
00700		DPYBIG(1);
00800		SETFORMAT(0,3);
00900		AIVECT(200,-440);DPYSST("X");
01000		AIVECT(275,-440);DPYSST("Y");
01100		AIVECT(350,-440);DPYSST("Z");
01200		AIVECT(425,-440);DPYSST("TRNDEL");
01300		AIVECT(200,-480);DPYSST("i-PAN");
01400		AIVECT(275,-480);DPYSST("k-TILT");
01500		AIVECT(350,-480);DPYSST("i-SWING");
01600		AIVECT(425,-480);DPYSST("ROTDEL");
01700		DEFINE IX="ECL[1,1]",IY="ECL[1,2]",IZ="ECL[1,3]",KX="ECL[3,1]",KY="ECL[3,2]",KZ="ECL[3,3]";
01800		PAN	←	ATAN2(IY,IX)*180/π;
01900		TILT	←	ATAN2(SQRT(KX↑2+KY↑2),KZ)*180/π;
02000		SWING	←	ATAN2(IZ,SQRT(IX↑2+IY↑2))*180/π;
02100		AIVECT(200,-460);DPYSST(CVG(ECL[4,1]));
02200		AIVECT(275,-460);DPYSST(CVG(ECL[4,2]));
02300		AIVECT(350,-460);DPYSST(CVG(ECL[4,3]));
02400		AIVECT(425,-460);DPYSST(CVG(TRNDEL));
02500		AIVECT(200,-500);DPYSST(CVG(PAN));
02600		AIVECT(275,-500);DPYSST(CVG(TILT));
02700		AIVECT(350,-500);DPYSST(CVG(SWING));
02800		AIVECT(425,-500);DPYSST(CVG(ROTDEL*180/π));
02900		DPYBIG(2);
03000		DPYOUT(2);
03100		SETFORMAT(0,7);
03200	END;
     

00100	PROCEDURE RESET;
00200	BEGIN	"RESET"
00300		INTEGER I;
00400		EVL[1,1]←0;ARRBLT(EVL[1,2],EVL[1,1],12);TILT←-3.14/2;
00500		EVL[1,1]←EVL[2,2]←EVL[3,3]←1;
00600		ECL[1,1]←ECL[2,2]←ECL[3,3]←1;
00700		ECL[4,1] ← 0;
00800		ECL[4,2] ← 250;
00900		ECL[4,3] ← 1000;
01000		XL←YL← -511;
01100		XH←YH←  511;
01200		DPYSET(DPYBUF);
01300		AIVECT(XL,YL);AVECT(XL,YH);AVECT(XH,YH);AVECT(XH,YL);AVECT(XL,YL);DPYOUT(0);
01400		MAX←0;MIN←999999;TIM←INITIM←CALL(0,"RUNTIM");
01500		TRNDEL	←	40;
01600		ROTDEL	←	π/8;
01700		CAMERADPY;
01800	END	"RESET";
     

00100	INTERNAL PROCEDURE FLYCAM;
00200	α THIS IS THE UNIDENTIFIED FLYING CAMERA SUB-COMMAND LISTEN LOOP;
00300		WHILE TRUE DO
00400	BEGIN
00500		INTEGER CHR,CTRL1,CTRL2,AXIS,SIGN;
00600		INTEGER I,J;
00700		LABEL L1,EOL;
00800		ECLDPY;
00900		CHR	←	INCHRW;
01000		IF CHR='175 THEN RETURN;
01100		IF CHR="R" THEN BEGIN RESET;GO EOL END;
01200	α ESCAPE KEY - ALT MODE;
01300		IF CHR = '175 THEN DONE;
01400	α CONTROL KEYS;
01500		CTRL1	←	CHR LAND '200;
01600		CTRL2	←	CHR LAND '400;
01700		CHR	←	CHR LAND '177;
01800	α POSITIVE DIRECTION KEYS;
01900		SIGN	←	+1;
02000		AXIS	←
02100		IF CHR="]" THEN 0 ELSE
02200		IF CHR=">" THEN 1 ELSE
02300		IF CHR="∧" THEN 2 ELSE
02400		IF CHR="⊃" THEN 3 ELSE 4;
02500		IF AXIS≠4 THEN  GO L1;
02600	α NEGATIVE DIRECTION KEYS;
02700		SIGN	←	-1;
02800		AXIS	←
02900		IF CHR="[" THEN 0 ELSE
03000		IF CHR="<" THEN 1 ELSE
03100		IF CHR="∨" THEN 2 ELSE
03200		IF CHR="¬" THEN 3 ELSE 4;
03300		IF AXIS=4 THEN GO EOL;
03400	
03500	α DOUBLE OR HALVE THE ROTATION - TRANSLATION STRENGTHS AS REQUIRED;
03600	L1:	IF AXIS=0 THEN
03700	BEGIN
03800		IF SIGN>0 THEN
03900		IF CTRL1 THEN ROTDEL ← 2 * ROTDEL 
04000			  ELSE TRNDEL ← 2 * TRNDEL ELSE
04100		IF CTRL1 THEN ROTDEL ← ROTDEL/2 
04200			  ELSE TRNDEL ← TRNDEL/2;
04300		GO EOL;
04400	END;
     

00100	α WORLD FRAME TRANSLATION    -  NO CTRL KEYS;
00200		IF CTRL1=0 THEN		IF CTRL2=0 THEN
00300		ECL[4,AXIS]	←	ECL[4,AXIS]  +  SIGN*TRNDEL ELSE
00400	
00500	α CAMERA FRAME TRANSLATION   -   CTRL2 ONLY;
00600		FOR I←1 STEP 1 UNTIL 3 DO
00700		ECL[4,I]	←	ECL[4,I]  +  SIGN*TRNDEL*ECL[AXIS,I] ELSE
00800	
00900	α ROTATIONS;
01000	BEGIN
01100		REAL ARRAY A,B[1:3,1:3];
01200		REAL C,S;
01300		C	←	COS(ROTDEL);
01400		S	←	SIGN*SIN(ROTDEL);
01500		ARRBLT(B[1,1],ECL[1,1],9);
01600		A[1,1]	←	0;
01700		ARRBLT(A[1,2],A[1,1],8);
01800		A[1,1]	←	A[2,2]	←	A[3,3]	←C;
01900		A[AXIS,AXIS]	←	1;
02000		I	←	IF AXIS=1 THEN 2 ELSE 1;
02100		J	←	IF AXIS=3 THEN 2 ELSE 3;
02200		IF AXIS=2 THEN I↔J;
02300		A[I,J]	←	 S;
02400		A[J,I]	←	-S;
02500	α CTRL1 ONLY  -   ROTATION ABOUT CAMERA'S AXIS;
02600		IF CTRL2=0 THEN
02700		FOR  I ← 1 STEP 1 UNTIL 3 DO
02800		FOR  J ← 1 STEP 1 UNTIL 3 DO
02900		ECL[I,J]  ←  A[I,1]*B[1,J]  +  A[I,2]*B[2,J]  +  A[I,3]*B[3,J] ELSE
03000		FOR  I ← 1 STEP 1 UNTIL 3 DO
03100		FOR  J ← 1 STEP 1 UNTIL 3 DO
03200		ECL[I,J]  ←  B[I,1]*A[1,J]  +  B[I,2]*A[2,J]  +  B[I,3]*A[3,J];
03300	END;
03400		CAMERADPY;
03500	EOL:	α END OF LOOP LABEL;
03600	END;
03700	END